home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / triton / examples / String.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  1.9 KB  |  72 lines
  1. PROGRAM Stringtest;
  2.  
  3. uses triton, tritonmacros, utility, vartags;
  4.  
  5. {
  6.    A demo in FPC Pascal using triton.library
  7.    
  8.    nils.sjoholm@mailbox.swipnet.se
  9. }
  10.  
  11.  
  12.  
  13. VAR
  14.      Project  : pTR_Project;
  15.      close_me : BOOLEAN;
  16.      trmsg : pTR_Message;
  17.      dummy : longint;
  18.      App : pTR_App;
  19.  
  20. begin
  21.  
  22.     App := TR_CreateApp(TAGS(
  23.                      TRCA_Name,longstr('Triton String Demo'),
  24.                      TRCA_Release,longstr('1'),
  25.                      TRCA_Date,longstr('03-06-1998'),
  26.                      TAG_DONE));
  27.     if App <> nil then begin 
  28.       ProjectStart;
  29.       WindowID(1);
  30.       WindowTitle('String');
  31.          VertGroupA;
  32.             Space;
  33.             HorizGroupAC;
  34.                Space;
  35.                TextID('_String',3);
  36.                Space;
  37.                StringGadget('Please change',3);
  38.                Space;
  39.             EndGroup;
  40.             Space;
  41.          EndGroup;
  42.       EndProject;
  43.  
  44.   Project := TR_OpenProject(App,@tritontags);
  45.     IF Project <> NIL THEN BEGIN
  46.       close_me := FALSE;
  47.       WHILE NOT close_me DO BEGIN
  48.         dummy := TR_Wait(App,0);
  49.         REPEAT
  50.           trmsg := TR_GetMsg(App);
  51.           IF trmsg <> NIL THEN BEGIN
  52.             IF (trmsg^.trm_Project = Project) THEN BEGIN
  53.                CASE trmsg^.trm_Class OF
  54.                  TRMS_CLOSEWINDOW : begin
  55.                                        writeln('The text was: ',TR_GetString(Project,3));
  56.                                        close_me := True;
  57.                                     end;
  58.                  TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
  59.                  TRMS_NEWVALUE    : IF trmsg^.trm_ID = 3 then writeln('<RETURN> or <TAB> was pressed in stringgadget');
  60.                END;
  61.             END;
  62.             TR_ReplyMsg(trmsg);
  63.           END;
  64.         UNTIL close_me OR (trmsg = NIL);
  65.       END;
  66.      TR_CloseProject(Project);
  67.    end;
  68.    TR_DeleteApp(App);
  69.    END ELSE writeln('Can''t create application');
  70. end.
  71.  
  72.